Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d1/freemacs.arc/EMACS.ASM

Assembly Source File | 1988-03-17 | 27KB | 1,428 lines

;History:243,45
test_prims    equ    0
    page    ,132

    .xlist
    include    memory.def
    include    mintdefs.asm
    include    /include/findfile.inc

data    segment    byte public

;the following externs are defined in 'mintprim'
    extrn    phd_seg: word
    extrn    read_errors: word
    extrn    write_errors: word

;the following externs are defined in 'mintscan'
    extrn    actptr: word
    extrn    fbgn: word, fend: word
    extrn    next_ids: word

;the following externs are defined in 'mintform'
    extrn    formhash: word
    extrn    syntax_table: word

;the following externs are defined in the computer-dependent file.
    extrn    max_screen_line: byte

    public    filename
filename    db    64 dup(?)
filename2    db    64 dup(?)

rename_error    db    'Rename error'
rename_error_len    equ    $-rename_error

    extrn    breakchar: word

    extrn    next_redisp_line: word

initial_ids    label    byte
db '#(rd)#(ow,(',13,10
db 'EMACS, a programmable editor - Version 1.03',13,10
db 'Copyright (C) Russell Nelson 1986, 1987',13,10
db '))'
db '#(ev)'
db '#(an,Loading #(env.EMACS)emacs.ed...)'
db '#(==,#(ll,#(env.EMACS)emacs.ed#(es,#(ls,(,)))),,('
db '    #(an,Starting editor...)'
db '    #(##(lib-name)&setup)'
db '),('
db '    #(ow,Cannot find '
db '        #(ev)'
db '        #(env.EMACS)emacs.ed - halting)'
db '    #(hl,1)'
db '))'
db 0

    public    standard_ids
standard_ids    db    '#(d,#(g))',0

nokbd_ids    db    '#(k)#(d,#(g))',0

byte_ptr    label    byte

foreback_color    label    word
fore_color    db    7
back_color    db    0


variable_table    label    byte
    db    'eFBpousfwnrctbml'
variable_count    equ    $-variable_table

lv_prim_table    label    word
    dw    lv_prim_e
    dw    lv_prim_Fore
    dw    lv_prim_Back
    dw    lv_prim_p
    dw    lv_prim_o
    dw    lv_prim_u
    dw    lv_prim_s
    dw    lv_prim_f
    dw    lv_prim_w
    dw    lv_prim_n
    dw    lv_prim_r
    dw    lv_prim_c
    dw    lv_prim_t
    dw    lv_prim_b
    dw    lv_prim_m
    dw    lv_prim_l

sv_prim_table    label    word
    dw    sv_prim_e
    dw    sv_prim_Fore
    dw    sv_prim_Back
    dw    sv_prim_p
    dw    sv_prim_o
    dw    sv_prim_u
    dw    sv_prim_s
    dw    sv_prim_f
    dw    sv_prim_w
    dw    sv_prim_n
    dw    sv_prim_r
    dw    sv_prim_c
    dw    sv_prim_t
    dw    sv_prim_b
    dw    sv_prim_m
    dw    sv_prim_l

    extrn    stackp: byte


data    ends


code    segment    byte public
    assume    cs:code, ds:data, es:data

    extrn    init_memory: near

    extrn    set_screen_color: near

    extrn    redisplay: near        ;ax=line to leave the cursor on.

    extrn    read_firstline: near
    extrn    read_lastline: near
    extrn    read_newrow: near
    extrn    read_linesbefore: near
    extrn    read_linecount: near
    extrn    read_buffer_modified: near
    extrn    store_buffer_modified: near

    extrn    read_showblanks: near
    extrn    store_showblanks: near

    extrn    read_top_percent: near
    extrn    read_bot_percent: near
    extrn    store_top_percent: near
    extrn    store_bot_percent: near

    extrn    read_panes: near
    extrn    read_other_window: near
    extrn    read_current_window: near
    extrn    store_panes: near
    extrn    store_other_window: near
    extrn    store_current_window: near

    extrn    chrout: near        ;al=char to overwrite to screen.

    extrn    paint_screen: near    ;sets entire screen to be repainted.

    extrn    paint_window: near    ;causes the current buffer to be shown in the current window.

    extrn    insert_string: near    ;si,cx describe the string.

    extrn    buffer_allocate: near    ;entry: cx=buffer number to select,
                    ;  cx=0 to create new buffer.
                    ;  ax=0 for read/write buffer.
                    ;exit: ax=new buffer number if enough
                    ;  memory, ax=0 otherwise.
    extrn    read_mark: near        ;entry: al=mark to read to.
                    ;exit: es:si, cx describing string.

    extrn    del_to_mark: near    ;entry: al=mark to delete to.

    extrn    set_mark: near        ;entry: al=dest mark, ah=source mark.

    extrn    goto_mark: near        ;entry: al-mark to go to.

    extrn    stack_marks: near    ;entry: ax>0 to create temp marks,
                    ;  ax=0 to delete temp marks,
                    ;  ax<0 to create perm marks and delete
                    ;  all temp marks.

    extrn    compute_cursor: near    ;exit with dx=column (0..65535)

    extrn    set_column: near    ;entry: ax=desired column

    extrn    set_line: near        ;entry: ax=desired line.

    extrn    ring_the_bell: near


;the following extrns are in the computer-dependent file
    extrn    xychrout: near
    extrn    clear_count: near
    extrn    position_cursor: near
    extrn    check_for_key: near
    public    xyputch
xyputch:
    jmp    xychrout


;the following extrns are in 'files'
    extrn    read_file: near
    extrn    write_file: near

;the following extrns are in 'search'
    extrn    regexp_pat: near
    extrn    literal_pattern: near
    extrn    search: near

;the following extrns are in 'mintscan'
    extrn    nomem: near

;the following externs are in 'pick'
    extrn    pick_on: near
    extrn    pick_off: near
    extrn    check_pick: near
    extrn    get_pick_values: near

    public    mint_init
mint_init:
;enter with ax=first free paragraph, bx=first paragraph after end of memory.
;exit with same results as init_memory returns.
    call    init_memory
    mov    next_ids,offset initial_ids
    ret

    public    init_ids
init_ids:
    mov    sp,offset stackp
    call    check_for_key        ;use the standard ids only if kbd ready.
    jnz    init_ids_1
    cmp    next_ids,offset standard_ids
    jne    init_ids_1
    mov    next_ids,offset nokbd_ids
init_ids_1:
    jmp    init_ids_continue

    extrn    init_ids_continue: near


;this routine should check for a break character.  If it gets one, it
;  gets rid of its return address and jump to init_ids.  Also, no registers
;  should be changed.
    public    check_breakchar
check_breakchar:
    push    ax
    call    check_for_key
    jz    check_breakchar_1
  if 1
    cmp    ax,7            ;^G?
  else
    cmp    ax,breakchar
  endif
    jne    check_breakchar_1
    call    get_key_value
    add    sp,4            ;get rid of the return address and ax.
    jmp    init_ids
check_breakchar_1:
    pop    ax
    ret


    if    test_prims

;test primitive.  fills memory to the max.  strictly for testing only.
ts_prim:
    di_points_fbgn
    mov    cx,actptr
    sub    cx,di
    dec    cx
    push    cx
    mov    al,' '
    rep    stosb
    pop    cx
    jmp    return_sicx


;dump formhash.  strictly for testing only.
tt_prim:
    mov    cx,256
    di_points_fbgn
    chk_actptr_cnt
    mov    si,offset formhash
tt_prim_1:
    test    cx,3fh
    jne    tt_prim_4
    mov    ax,LINENEW
    stosw
tt_prim_4:
    mov    dx,0
    lodsw
    mov    bx,ax
tt_prim_2:
    cmp    bx,NIL        ;at end of list yet?
    je    tt_prim_3
    mov    bx,[bx].hash_link
    inc    dx
    jmp    tt_prim_2
tt_prim_3:
    mov    ax,dx        ;get the count
    add    al,'0'        ;convert to ascii (cheaply)
    stosb
    loop    tt_prim_1
    jmp    return_tos

    endif

;redisplay.
rd_prim:
    call    getarg1
    jcxz    rd_prim_1
    call    paint_screen        ;paint,
    call    paint_window
    jmp    short rd_prim_3        ; always redisplay
rd_prim_1:
    call    check_for_key        ;redisplay only if no key waiting.
    jnz    rd_prim_2
rd_prim_3:
    call    redisplay
rd_prim_2:
    jmp    return_null


st_prim:
;set the syntax table.
    call    find_arg1
    jc    st_prim_1
    mov    bx,NIL            ;if form not found, use NIL.
st_prim_1:
    mov    syntax_table,bx        ;remember where the syntax table is.
    jmp    return_null



;overwrite the screen.
ow_prim:
    call    getarg1
    jcxz    ow_prim_2
ow_prim_1:
    lodsb
    xor    ah,ah
    call    chrout
    push    si
    push    cx
    pop    cx
    pop    si
    loop    ow_prim_1
ow_prim_2:
    jmp    return_null


    extrn    get_math: near
    extrn    gotoxy: near

;gotoxy
xy_prim:
    call    get_math
    mov    dh,al
    mov    dl,bl
    call    gotoxy
    jmp    return_null


;announce a string
an_prim:
    mov    bx,80            ;end of the line.
    mov    dl,max_screen_line    ;get the row.
    inc    dl
    mov    cx,2            ;if the second arg is non-null,
    call    getarg
    jcxz    an_prim_1
    call    read_lastline        ;  put the announcement after the current window.
    mov    dl,al
an_prim_1:
    inc    dl            ;put our announcement after it.
    mov    dh,0            ;start in this column

    push    cx            ;remember if arg2 is null or not.

    call    getarg1
    jcxz    an_prim_2        ;if null, we're done.
    cmp    cx,bx            ;more than we can print?
    jb    an_prim_3        ;no.
    mov    cx,bx            ;yes - print only as many as will fit.
an_prim_3:
    lodsb
    mov    ah,0
    call    xychrout
    inc    dh
    loop    an_prim_3
an_prim_2:

    pop    cx            ;pop the size of arg2.
    or    cx,cx
    jne    an_prim_4        ;if it's null,
    call    position_cursor        ;  put the cursor at the end of the string
an_prim_4:
    call    clear_count        ;clear to the end of the annunciator.
    jmp    return_null


;insert a string.
is_prim:
    call    getarg1
    call    insert_string
    jc    is_prim_1        ;go if we can't insert it.
    jmp    return_null
is_prim_1:
    mov    cx,2
    jmp    return_arg


lv_prim:
;load variable
    mov    bx,offset lv_prim_table
    call    parse_variable
    call    word ptr [bx]
    di_points_fbgn
    jmp    return_number

lv_prim_e:
    mov    ax,actptr
    sub    ax,fend
    ret

lv_prim_Fore:
    mov    ah,0
    mov    al,fore_color
    ret

lv_prim_Back:
    mov    ah,0
    mov    al,back_color
    ret

lv_prim_p:
    call    read_panes
    mov    ah,0
    ret

lv_prim_o:
    call    read_other_window
    ret

lv_prim_u:
    call    read_current_window
    ret

lv_prim_s:
    call    read_top_percent
    mov    ah,0
    ret
lv_prim_f:
    call    read_bot_percent
    mov    ah,0
    ret
lv_prim_w:
    call    read_showblanks
    inc    ax
    ret
lv_prim_n:
    call    read_linecount
    inc    ax
    ret
lv_prim_r:
    call    read_newrow
    inc    ax
    ret
lv_prim_c:
    call    compute_cursor
    mov    ax,dx
    inc    ax
    ret
lv_prim_t:
    call    read_firstline
    mov    ah,0
    inc    ax
    ret
lv_prim_b:
    call    read_lastline
    mov    ah,0
    inc    ax
    ret
lv_prim_m:
    call    read_buffer_modified
    mov    ah,0
    ret
lv_prim_l:
    call    read_linesbefore
    inc    ax
    ret


sv_prim:
;store variable
    mov    bx,offset sv_prim_table
    call    parse_variable
    mov    cx,2
    call    getarg
    push    bx
    call    get_decimal
    pop    bx
    call    word ptr [bx]
    jmp    return_null

sv_prim_Fore:
    mov    fore_color,al
    mov    ax,foreback_color
    call    set_screen_color
    ret

sv_prim_Back:
    mov    back_color,al
    mov    ax,foreback_color
    call    set_screen_color
    ret


sv_prim_p:
    call    store_panes
    ret

sv_prim_o:
    call    store_other_window
    ret

sv_prim_u:
    call    store_current_window
    ret

sv_prim_s:
    call    store_top_percent
    ret
sv_prim_f:
    call    store_bot_percent
    ret
sv_prim_w:
    call    store_showblanks    ;whitespace.
    ret
sv_prim_e:
sv_prim_n:
sv_prim_t:
sv_prim_b:
    ret
sv_prim_r:
    mov    next_redisp_line,ax
    ret
sv_prim_c:
    call    set_column
    ret
sv_prim_m:
    call    store_buffer_modified
    ret
sv_prim_l:
    call    set_line
    ret




parse_variable:
;parse a variable letter.
;return bx -> proper entry in the table pointed to by bx on entry.
;the default is at the end of the table.
    call    getarg1
    mov    al,0        ;defaults to line
    jcxz    parse_variable_1
    lodsb
parse_variable_1:
    mov    di,offset variable_table
    mov    cx,variable_count
    repne    scasb
    sub    cx,variable_count-1
    neg    cx
    shl    cx,1
    add    bx,cx
    ret


pp_prim:
    di_points_fbgn
    mov    cx,11            ;make sure there's enough room.
    chk_actptr_cnt
    call    get_pick_values
    push    dx            ;save vertical
    mov    ax,cx
    mov    cx,0
    mov    bx,10
    call    put_number
    mov    al,','
    stosb
    pop    ax            ;pushed as dx
    jmp    return_number


sa_prim:
    mov    bx,fend            ;make bx point to some free memory.
    add    bx,2
    mov    si,fbgn            ;point si at "sa".
    mov    si,[si]            ;point si at the first arg.
    mov    dx,0            ;count the arguments here.
sa_prim_1:
    cmp    si,[si]            ;are we pointing at fend?
    je    sa_prim_2
    mov    [bx],si            ;save a pointer to the argument.
    add    bx,2
    cmp    bx,actptr        ;enough room for the pointer?
    jb    $+5
    jmp    nomem
    mov    si,[si]            ;make it point to next arg.
    inc    dx
    jmp    sa_prim_1
sa_prim_2:
    mov    cx,dx            ;prepare to compare again.
    jcxz    sa_prim_4        ;no arguments - we're done.
    dec    cx            ;we look at n-1 arguments.
    jcxz    sa_prim_4        ;no arguments - we're done.
    mov    bx,fend            ;make bx point to some free memory.
    add    bx,2
    mov    bp,0            ;keep a "swapped" flag here.
sa_prim_3:
    push    cx

    mov    si,[bx]            ;get the two arguments under consideration.
    mov    di,[bx+2]

    mov    ax,[si]            ;compute length of this arg.
    sub    ax,si
    sub    ax,mark_overhead
    add    si,mark_overhead-1    ;make si=> text of argument.

    mov    cx,[di]            ;compute length of this arg.
    sub    cx,di
    sub    cx,mark_overhead
    add    di,mark_overhead-1    ;make si=> text of argument.

    cmp    ax,cx            ;if the first string is shorter,
    jb    sa_prim_8        ;  return if if they're equal.

                    ;second string is smaller.
    push    cx
    repe    cmpsb            ;compare the two strings
    pop    cx
    jb    sa_prim_5        ;go if they're in order already.
    ja    sa_prim_6        ;if they're not in order, swap them.
    cmp    ax,cx            ;were the strings equal?
    je    sa_prim_5        ;yes - don't swap them.
    jmp    short sa_prim_6

sa_prim_8:
    xchg    cx,ax            ;first string is smaller.
    repe    cmpsb            ;compare the two strings
    jbe    sa_prim_5        ;go if they're in order already.

sa_prim_6:
    mov    ax,[bx]            ;swap them.
    xchg    ax,[bx+2]
    mov    [bx],ax
    inc    bp            ;remember that we found one out of order.
sa_prim_5:
    pop    cx
    add    bx,2
    loop    sa_prim_3

    or    bp,bp            ;did we swap any?
    jne    sa_prim_2        ;yes - not done sorting.

sa_prim_4:
    mov    bx,fend            ;make bx point to some free memory.
    add    bx,2
    mov    di,bx            ;compute the end of the table.
    add    di,dx
    add    di,dx
    push    di
sa_prim_7:
    mov    si,[bx]
    add    bx,2
    mov    cx,[si]            ;compute length of this arg.
    sub    cx,si
    sub    cx,mark_overhead
    add    si,mark_overhead-1    ;make si=> text of argument.
    inc    cx            ;include space for the comma.
    chk_actptr_cnt
    dec    cx
    rep    movsb
    mov    al,','            ;comma seperate the strings.
    stosb

    dec    dx            ;done with all of them?
    jne    sa_prim_7        ;no - do another.

    jmp    return_tos


bl_prim:
    call    ring_the_bell
    jmp    return_null


;push/pop marks
pm_prim:
    call    getarg1
    call    get_decimal
    call    stack_marks
    jc    pm_prim_1
    jmp    return_null
pm_prim_1:
    mov    cx,2
    jmp    return_arg_active


;set mark (to point)
sm_prim:
    mov    cx,2
    call    getarg_mark
    mov    al,'.'        ;if 2nd is missing, use '.'
    jcxz    sm_prim_1
    lodsb
sm_prim_1:
    mov    ah,al        ;get source mark
    push    ax        ;save source mark
    call    getarg_mark1
    pop    bx        ;pushed as ax
    mov    ah,bl        ;get dest mark
    call    set_mark
    jmp    return_null


;set point (to marks)
sp_prim:
    mov    cx,1
    call    getarg
    jcxz    sp_prim_1
sp_prim_2:
    lodsb
    push    si
    push    cx
    call    goto_mark
    pop    cx
    pop    si
    loop    sp_prim_2
sp_prim_1:
    jmp    return_null


;delete to mark
dm_prim:
    call    getarg_mark1
    call    del_to_mark
    jmp    return_null


;read to mark
rm_prim:
    call    getarg_mark1    ;get mark number to read from.
    call    read_mark    ;returns es:si, cx describing string.
    assume    ds:nothing
;    di_points_fbgn
    mov    di,fbgn
    dec    di
    push    di
;    check_actptr_count
    push    di
    add    di,cx
    jc    rm_prim_1    ;if overflow, there must be no room.
    cmp    di,actptr    ;if collision with actptr, . .
    jae    rm_prim_1
    pop    di
    rep    movsb        ;move the string.
    push    es        ;restore our ds.
    pop    ds
    jmp    return_tos
rm_prim_1:
    add    sp,4        ;conserve the stack.
    push    es        ;restore our ds.
    pop    ds
    mov    cx,2
    jmp    return_arg_active
    assume    ds:data


;count to mark
rc_prim:
    call    getarg_mark1    ;get mark number to read from.
    call    read_mark    ;returns ds:si, cx describing string.
    push    es        ;restore our ds.
    pop    ds
    mov    ax,cx
    di_points_fbgn
    jmp    return_number


;mark before point #(mb,mark,before,after)
mb_prim:
    call    getarg_mark1
    call    read_mark
    push    es        ;restore our ds.
    pop    ds
    jc    mb_prim_1    ;go if point is before mark
    mov    cx,2
    jmp    return_arg
mb_prim_1:
    mov    cx,3
    jmp    return_arg



;look pattern.  return arg 2 if bad pattern.
lp_prim:
    call    getarg1
    call    literal_pattern
    jc    lp_prim_1
    jmp    return_null
lp_prim_1:
    mov    cx,2
    jmp    return_arg_active


;look regular.  return arg 2 if bad pattern.
lr_prim:
    call    getarg1
    call    regexp_pat
    jc    lr_prim_1
    jmp    return_null
lr_prim_1:
    mov    cx,2
    jmp    return_arg_active


;look for a string.  return arg 1 if not found.
lk_prim:
    call    getarg_mark1
    push    ax
    mov    cx,2
    call    getarg_mark
    push    ax
    mov    cx,3
    call    getarg_mark
    push    ax
    mov    cx,4
    call    getarg_mark
    mov    dl,al        ;set arg 4 (last)
    pop    ax        ;restore arg 3 (first)
    mov    dh,al
    pop    cx        ;restore arg 2 (end) pushed as ax.
    pop    ax        ;restore arg 1 (start)
    mov    ch,al
    call    search
    jc    lk_prim_1
    jmp    return_null
lk_prim_1:
    mov    cx,5
    jmp    return_arg_active


;find the first and next occurrences of a file.
ff_prim:
    mov    dx,offset filename2
    mov    ah,1ah
    int    21h
    call    getarg1_filename
    di_points_fend
    mov    dx,si
    mov    ah,4eh            ;find first matching file
    mov    cx,0
ff_prim_1:
    int    21h            ;find first or find next.
    jc    ff_prim_2
    mov    si,offset filename2.find_buf_name
ff_prim_3:
    lodsb
    or    al,al
    je    ff_prim_4
    chk_actptr
    stosb
    jmp    ff_prim_3
ff_prim_4:
    mov    cx,2            ;copy the separator argument.
    call    getarg
    chk_actptr_cnt
    rep    movsb

    mov    ah,4fh            ;find next.
    jmp    ff_prim_1
ff_prim_2:
    jmp    return_tos


;rename a file.
rn_prim:
    call    getarg1_filename
    mov    cx,2
    call    getarg
    mov    di,offset filename2
    rep    movsb
    xor    al,al
    stosb
    mov    dx,offset filename
    mov    di,offset filename2
    mov    ah,56h            ;rename file
    int    21h
    jnc    rn_prim_1
    mov    si,offset rename_error
    mov    cx,rename_error_len
    jmp    return_sicx
rn_prim_1:
    jmp    return_null


;delete a file.
de_prim:
    call    getarg1_filename
    mov    dx,si
    mov    ah,41h            ;delete file
    int    21h
    jnc    de_prim_1
    mov    al,2
    mov    bx,offset read_errors
    jmp    return_string
de_prim_1:
    jmp    return_null


;read a file
rf_prim:
    call    getarg1_filename
    call    read_file
    mov    bx,offset read_errors
    jmp    return_string


;write a file.
wf_prim:
    call    getarg1_filename
    push    si            ;preserve the pointer to the filename.
    mov    cx,2
    call    getarg_mark
    pop    si
    call    write_file
    mov    bx,offset write_errors
    jmp    return_string


;allocate a buffer
ba_prim:
    call    getarg1
    call    get_decimal
    push    ax
    mov    cx,2
    call    getarg
    mov    ax,cx
    pop    cx            ;pushed as ax.
    call    buffer_allocate
    di_points_fbgn
    jmp    return_number


;insert from a buffer
;#(bi,buffer number,mark,yes,no)
bi_prim:
    call    getarg1            ;get the buffer number.
    call    get_decimal
    push    ax
    mov    cx,2            ;get the mark.
    call    getarg_mark
    pop    cx
    call    buffer_insert
    jc    bi_prim_1        ;go if we can't insert it.
    mov    cx,3
    jmp    return_arg
bi_prim_1:
    mov    cx,4
    jmp    return_arg


ao_prim:
    call    getarg1        ;get the first argument
    mov    dx,cx        ;save size of first argument
    mov    di,si        ;save pointer to first argument
    mov    cx,2        ;get second argument
    call    getarg
    cmp    cx,dx        ;second shorter than first?
    jb    ao_prim_2    ;yes - use second's length.
    mov    cx,dx        ;no - use first's length.
    repe    cmpsb        ;strings alphabetically ordered?
    jb    ao_prim_4    ;no, return 4th.
    jmp    short ao_prim_3
ao_prim_2:
    repe    cmpsb        ;strings alphabetically ordered?
    jbe    ao_prim_4    ;no, return 4th.
ao_prim_3:
    mov    cx,3
    jmp    return_arg
ao_prim_4:
    mov    cx,4
    jmp    return_arg


it_prim:
;check for key, timed.
    call    check_for_key        ;character waiting?
    jne    it_prim_1        ;yes - don't turn the pick on.
    call    pick_on
    call    it_prim_1
    call    pick_off
    ret
it_prim_1:
    call    getarg1
    call    get_decimal
    mov    bp,ax            ;save the wait time.
    xor    si,si            ;si is the elapsed time.
    mov    ah,2ch            ;get the current hundreths.
    int    21h
    mov    bl,dl
it_prim_2:
    call    check_for_key        ;character waiting?
    jne    it_prim_3        ;yes - return it.
    call    check_pick        ;pick waiting?
    jne    ic_prim_2        ;yes - return it.
    mov    ah,2ch            ;gtime
    int    21h
    mov    al,dl            ;subtract the new time from the old.
    sub    al,bl
    mov    bl,dl            ;update the time in bl.
    cbw
    jns    it_prim_4        ;go if it's positive.
    add    ax,100            ;make it positive.
it_prim_4:
    add    si,ax            ;add in to the current time.
    cmp    si,bp            ;time to timeout yet?
    jb    it_prim_2        ;no.
    mov    ax,255            ;yes - timeout.
    jmp    short ic_prim_2
it_prim_3:
    or    bp,bp            ;original wait time.
    jz    ic_prim_2        ;if zero wait, we're just checking.
    call    get_key_value
ic_prim_2:
    cmp    ax,breakchar        ;is it the break char?
    je    ic_prim_1        ;yes - halt.
    call    decode_key        ;no - change the key into a string.
    di_points_fbgn
    chk_actptr_cnt
    rep    movsb
    jmp    return_tos
ic_prim_1:
    jmp    init_ids


    if    0
lc_prim:
    call    getarg1
    di_points_fbgn
    chk_actptr_cnt
    jcxz    lc_prim_1
lc_prim_2:
    lodsb
    cmp    al,'A'
    jb    lc_prim_3
    cmp    al,'Z'
    ja    lc_prim_3
    add    al,'a'-'A'
lc_prim_3:
    stosb
    loop    lc_prim_2
lc_prim_1:
    jmp    return_tos

    endif


bc_prim:
    mov    cx,2        ;get 'from' argument.
    call    getarg
    mov    dl,'a'        ;default to ASCII
    jcxz    bc_prim_1
    mov    dl,[si]        ;get from type.
bc_prim_1:
    mov    cx,3        ;get 'to' argument.
    call    getarg
    mov    dh,'d'        ;default to decimal
    jcxz    bc_prim_2
    mov    dh,[si]
bc_prim_2:
    call    getarg1
    call    bc_prim_base    ;get the source base.
    or    bx,bx        ;ASCII?
    jnz    bc_prim_4    ;no.
    jcxz    bc_prim_6
    lodsb
    mov    ah,0
    jmp    bc_prim_3
bc_prim_6:
    mov    ax,-1        ;if ASCII, and null argument, use -1.
    jmp    bc_prim_3
bc_prim_4:
    push    dx        ;preserve dx.
    call    get_number
    pop    dx
bc_prim_3:
;we now have the number in ax.
    mov    dl,dh
    call    bc_prim_base
    di_points_fbgn
    or    bx,bx
    jnz    bc_prim_5
    stosb
    jmp    return_tos
bc_prim_5:
    mov    cx,0        ;use only as many digits as are needed.
    call    put_number
    jmp    return_tos


;private subroutine, used only bc_prim.
bc_prim_base:
;enter with dl=base character.
;exit with bx=base if number; bx=0 if ASCII.
    or    dl,20h        ;convert UPPER case to lower case.
    cmp    dl,'d'
    jne    bc_prim_base_1
    mov    bx,10
    ret
bc_prim_base_1:
    cmp    dl,'o'
    jne    bc_prim_base_2
    mov    bx,8
    ret
bc_prim_base_2:
    cmp    dl,'h'
    jne    bc_prim_base_3
    mov    bx,16
    ret
bc_prim_base_3:
    cmp    dl,'c'
    jne    bc_prim_base_4
    mov    bx,0
    ret
bc_prim_base_4:
    cmp    dl,'a'        ;a alias character.
    jne    bc_prim_base_5
    mov    bx,0
    ret
bc_prim_base_5:
    cmp    dl,'b'
    jne    bc_prim_base_6
    mov    bx,2
    ret
bc_prim_base_6:
    ret


getarg_mark1:
    mov    cx,1
getarg_mark:
;enter with cx=arg number.
;exit with al=mark, cx=arg size, si->arg.
    call    getarg
    mov    al,0        ;use null if no string specified.
    jcxz    getarg_mark_1
    mov    al,[si]        ;get the first character
getarg_mark_1:
    ret


    public    trace_invoke
trace_invoke:
    public    trace_result
trace_result:
    ret

ex_prim:
    call    getarg1_filename
    push    si
    mov    cx,2
    call    getarg
    pop    di
    call    execute_program
    di_points_fbgn
    jmp    return_number

ef_prim:
    mov    cx,3
    call    getarg_mark
    push    ax
    call    getarg1_filename
    push    si
    mov    cx,2
    call    getarg
    pop    di
    pop    ax
    call    execute_filter
    di_points_fbgn
    jmp    return_number

    extrn    execute_program: near
    extrn    execute_filter: near

    extrn    get_key_value: near
    extrn    decode_key: near
    extrn    buffer_insert: near

    extrn    return_arg: near
    extrn    return_number: near
    extrn    return_null: near
    extrn    return_sicx: near
    extrn    return_tos: near
    extrn    return_arg_active: near
    extrn    return_string: near
    extrn    getarg1_filename: near
    extrn    getarg_filename: near
    extrn    getarg1: near
    extrn    getarg: near
    extrn    get_decimal: near
    extrn    get_number: near
    extrn    put_number: near
    extrn    find_arg1: near

;the following externs are defined in mintprim.asm
    extrn    dflt: near
    extrn    hl_prim: near
    extrn    eq_prim: near
    extrn    nc_prim: near
    extrn    db_prim: near
    extrn    dt_prim: near
    extrn    tm_prim: near
;forms
    extrn    ds_prim: near
    extrn    ss_prim: near
    extrn    cl_prim: near
    extrn    cc_prim: near
    extrn    cn_prim: near
    extrn    cr_prim: near
    extrn    in_prim: near
    extrn    ev_prim: near
    extrn    ln_prim: near
    extrn    dd_prim: near
    extrn    sb_prim: near
    extrn    fb_prim: near
    extrn    nb_prim: near
;math
    extrn    ad_prim: near
    extrn    su_prim: near
    extrn    ml_prim: near
    extrn    dv_prim: near
    extrn    md_prim: near
    extrn    gr_prim: near

    public    ex_prim
    public    ef_prim

    public    sa_prim
    public    is_prim
    public    bc_prim
    public    sv_prim
    public    lv_prim
    public    pp_prim
    public    bl_prim
    public    sm_prim
    public    sp_prim
    public    dm_prim
    public    rm_prim
    public    rc_prim
    public    mb_prim
    public    lp_prim
    public    lr_prim
    public    lk_prim
    public    rf_prim
    public    wf_prim
    public    an_prim
    public    ow_prim
    public    xy_prim
    public    pm_prim
    public    ba_prim
    public    bi_prim
    public    ff_prim
    public    rn_prim
    public    de_prim
    public    st_prim
  if test_prims
    public    ts_prim
    public    tt_prim
  endif


code    ends

data    segment    byte public
    public    function_name_table
    public    function_name_length
    public    function_address

function_name_table    label    word
    db    'rd'
    db    'it'

    db    '=='            ;equals
    db    'nc'            ;number of characters
    db    'dt'            ;date
    db    'tm'            ;time
    db    'a?'            ;alphabetic ordered?
    db    'sa'            ;sort ascending
;forms
    db    'ds'            ;define string
    db    'mp'            ;make parameter
    db    'gs'            ;get string
    db    'go'            ;get one
    db    'gn'            ;get n
    db    'rs'            ;reset string
    db    'fm'            ;first match
    db    'ev'            ;read enviornment
    db    'ls'            ;list strings
    db    'es'            ;erase string
    db    'sl'            ;save library
    db    'll'            ;load library
    db    'n?'            ;name exists?
;math
    db    '++'            ;add
    db    '--'            ;subtract
    db    '**'            ;multiply
    db    '//'            ;divide
    db    '%%'            ;modulus
    db    'g?'            ;numeric greater

    db    'is'            ;insert string
    db    'bc'            ;base conversion
    db    'sv'            ;set variable
    db    'lv'            ;load variable
    db    'pp'            ;pick position
    db    'bl'            ;bell
    db    'sm'            ;set mark
    db    'sp'            ;set point
    db    'dm'            ;del to mark
    db    'rm'            ;read to mark
    db    'rc'            ;read to mark
    db    'mb'            ;mark before
    db    'lp'            ;look pattern
    db    'lr'            ;look regexp
    db    'lk'            ;look
    db    'rf'            ;read file
    db    'wf'            ;write file
    db    'an'            ;announce
    db    'ow'            ;overwrite
    db    'xy'            ;gotoxy
    db    'pm'            ;push/pop mark
    db    'ba'            ;buffer allocate
    db    'bi'            ;buffer insert
    db    'ff'            ;find files
    db    'rn'            ;rename file
    db    'de'            ;delete file
    db    'st'            ;syntax table
    db    'hl'            ;halt
    db    'db'            ;debug
    db    'ex'
    db    'ef'
  if test_prims
    db    'ts'
    db    'tt'
  endif

function_name_length    equ ($-function_name_table)/2

    dw    dflt
function_address    label    word
    dw    rd_prim        ;redisplay
    dw    it_prim        ;input timed.
    dw    eq_prim
    dw    nc_prim
    dw    dt_prim
    dw    tm_prim
    dw    ao_prim
    dw    sa_prim
;forms
    dw    ds_prim
    dw    ss_prim
    dw    cl_prim
    dw    cc_prim
    dw    cn_prim
    dw    cr_prim
    dw    in_prim
    dw    ev_prim
    dw    ln_prim
    dw    dd_prim
    dw    sb_prim
    dw    fb_prim
    dw    nb_prim
;math
    dw    ad_prim
    dw    su_prim
    dw    ml_prim
    dw    dv_prim
    dw    md_prim
    dw    gr_prim

    dw    is_prim        ;insert string
    dw    bc_prim        ;base convert
    dw    sv_prim        ;set variable
    dw    lv_prim        ;load variable
    dw    pp_prim        ;pick position
    dw    bl_prim        ;bell
    dw    sm_prim        ;set mark
    dw    sp_prim        ;set point
    dw    dm_prim        ;delete to mark
    dw    rm_prim        ;read to mark
    dw    rc_prim        ;count to mark
    dw    mb_prim        ;mark before
    dw    lp_prim        ;look pattern
    dw    lr_prim        ;look regexp
    dw    lk_prim        ;look
    dw    rf_prim        ;read file
    dw    wf_prim        ;write file
    dw    an_prim        ;announce
    dw    ow_prim        ;overwrite
    dw    xy_prim        ;gotoxy
    dw    pm_prim        ;push/pop mark
    dw    ba_prim        ;buffer allocate
    dw    bi_prim        ;buffer insert
    dw    ff_prim        ;find first/next
    dw    rn_prim        ;rename file
    dw    de_prim        ;delete file
    dw    st_prim        ;set the syntax table.
    dw    hl_prim
    dw    db_prim
    dw    ex_prim
    dw    ef_prim
  if test_prims
    dw    ts_prim        ;test
    dw    tt_prim        ;test two
  endif

data    ends


    end